HPAVC/HPAVC CD-ROM.iso/pc/DDPLUS71.ZIP/RIPLINK.ZIP/RIPLINK.PA1

Text File | 1994-06-25 | 29.6 KB | 1,238 lines

{Include file for RipLink(tm) - Copyright (C) 1994 by InterProgramming}
{                               All rights reserved                   }

{This include file contains the majority of the actual display routines for
 RIPlink.  RIPLINK.PAS containes the routines to parse/process the RIPscrip
 commands.  }

Procedure RipObj.rTextWindow(x0,y0,x1,y1:byte; wrap:boolean; size:byte);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    if (x0=0) and (y0=0) and (x1=0) and (y1=0) then
      textactive := false
    else
    begin
      if (x0 = textx0) and (y0 = texty0) and (x1 = textx1) and (y1 = texty1) and (size = textsize) then
        textwrap := wrap
      else
      begin
        textx0 := x0;     texty0 := y0;
        textx1 := x1;     texty1 := y1;
        textsize := size; textwrap := wrap;
        textactive := true;
        textclr := 15;
        fillchar(virtualwindow,7826,#0);
        rHome;
      end;
    end;
    statline;
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rViewPort(x0,y0,x1,y1:word);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    {textcolor(0);}
    setviewport(x0,y0,x1,y1,true);
    statline;
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rResetWindows;
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    KillRegions;
    MouseOff;
    {$ENDIF}
    textx0 := 0;  texty0 := 0;
    textx1 := 79; texty1 := 42;
    textsize := 0;
    textwrap := true;
    textactive := true;
    textclr := 15;
    cursorx := 0; cursory := 0;
    cursoron := false;
    fillchar(virtualwindow,7826,#0);
    SetViewPort(0,0,GetMaxX,GetMaxY-12,ClipOn);
    ClearViewPort;
    graphdefaults;
    settextjustify(lefttext,toptext);
    DefColor := GetColor;
    CurFont := 0;
    CurSize := 1;
    Metric := MetricArray[CurFont,CurSize];
    if clipb <> nil then
    begin
      FreeMem(ClipB,ClipSize);
      ClipSize := 0;
      ClipB := nil;
    end;
    statline;
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rEraseWindow;
var
  fst : fillsettingstype;
begin
  if LocalRip and TextActive then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    getfillsettings(fst);
    setfillstyle(0,fst.color);
    fillchar(virtualwindow,7826,#0);
    Bar(TextOffsetX[textsize]*textx0,TextOffsetY[textsize]*texty0,
        TextOffsetX[textsize]*(textx1+1)-1,TextOffsetY[textsize]*(texty1+1)-1);
    setfillstyle(fst.pattern,fst.color);
    rHome;
    statline;
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rEraseView;
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    ClearViewPort;
    statline;
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rGotoXY(x0,y0:byte);
begin
  if LocalRip and textactive then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    cursorx := textx0+x0;
    cursory := texty0+y0;
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rHome;
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    cursorx := textx0;
    cursory := texty0;
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rEraseEOL;
var
  fst : fillsettingstype;
  ctr : byte;
begin
  if LocalRip and TextActive then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    getfillsettings(fst);
    setfillstyle(0,fst.color);
    {fillchar(virtualwindow,7826,#0);}
    Bar(TextOffsetX[textsize]*cursorx,TextOffsetY[textsize]*cursory,
        TextOffsetX[textsize]*(textx1+1)-1,TextOffsetY[textsize]*(cursory+1)-1);
    setfillstyle(fst.pattern,fst.color);
    for ctr := cursorx to TextMaxX[textsize] do
      virtualwindow[ctr,cursory,0] := 0;
    rHome;
    statline;
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rColor(clr:byte);
begin
  if LocalRip then
  begin
    SetColor(clr);
    DefColor := clr;
  end;
end;

Procedure RipObj.rSetPalette(c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15,c16:word);
var
  palette       : palettetype;
begin
  with palette do
  begin
    size := 16;
    colors[0]  := c1;
    colors[1]  := c2;
    colors[2]  := c3;
    colors[3]  := c4;
    colors[4]  := c5;
    colors[5]  := c6;
    colors[6]  := c7;
    colors[7]  := c8;
    colors[8]  := c9;
    colors[9]  := c10;
    colors[10] := c11;
    colors[11] := c12;
    colors[12] := c13;
    colors[13] := c14;
    colors[14] := c15;
    colors[15] := c16;
  end;
  if LocalRip then
    SetAllPalette(Palette);
end;

Procedure RipObj.rOnePalette(color,value:word);
begin
  if LocalRip then
    SetPalette(color,value);
end;

Procedure RipObj.rWriteMode(mode:byte);
begin
  if LocalRip then
    SetWriteMode(mode);
end;

Procedure RipObj.rMove(x0,y0:word);
begin
  if LocalRip then
    MoveTo(x0,y0);
end;

Procedure RipObj.rText(instr:string);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    settextjustify(lefttext,toptext);
    OutText(instr);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rTextXY(x0,y0:word; instr:string);
begin
  if not LocalRip then
    exit;
  {$IFDEF MOUSE}
  MouseOff;
  {$ENDIF}
  settextjustify(lefttext,toptext);
  outtextxy(x0,y0,instr);
  {$IFDEF MOUSE}
  MouseOn;
  {$ENDIF}
end;

Procedure RipObj.rFontStyle(font,direct,size:byte);
begin
  if LocalRip then
  begin
    {$IFDEF FONTFILE}
    if fontptr <> nil then
    begin
      freemem(fontptr,fontsize);
      fontptr := nil;
    end;
    case font of
      1  : begin fontsize := 16677; seek(charfile,  5527); end;
      2  : begin fontsize :=  5131; seek(charfile, 22204); end;
      3  : begin fontsize := 13596; seek(charfile, 27335); end;
      4  : begin fontsize := 18063; seek(charfile, 40931); end;
      5  : begin fontsize := 10987; seek(charfile, 58994); end;
      6  : begin fontsize :=  8437; seek(charfile, 69981); end;
      7  : begin fontsize := 17355; seek(charfile, 78418); end;
      8  : begin fontsize := 12083; seek(charfile, 95773); end;
      9  : begin fontsize :=  8439; seek(charfile,107856); end;
      10 : begin fontsize := 14670; seek(charfile,116295); end;
    end;
    if font <> 0 then
    begin
      getmem(fontptr,fontsize);
      blockread(charfile,fontptr^,fontsize);
      if registerbgifont(fontptr) < 0 then ;
    end;
    {$ENDIF}
    SetTextStyle(font,direct,size);
    CurFont := font;
    CurSize := size;
    Metric := MetricArray[CurFont,CurSize];
  end;
end;

Procedure RipObj.rPixel(x0,y0:word);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    PutPixel(x0,y0,defcolor);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rLine(x0,y0,x1,y1:word);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    Line(x0,y0,x1,y1);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rRectangle(x0,y0,x1,y1:word);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    Rectangle(x0,y0,x1,y1);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rBar(x0,y0,x1,y1:word);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    Bar(x0,y0,x1,y1);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rCircle(x0,y0,radius:word);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    Circle(x0,y0,radius);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rOval(x0,y0,stangle,endangle,xrad,yrad:word);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    Ellipse(x0,y0,stangle,endangle,xrad,yrad);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rFilledOval(x0,y0,xrad,yrad:word);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    FillEllipse(x0,y0,xrad,yrad);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rArc(x0,y0,stangle,endangle,rad:word);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    Arc(x0,y0,stangle,endangle,rad);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rPieSlice(x0,y0,stangle,endangle,rad:word);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    PieSlice(x0,y0,stangle,endangle,rad);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rOvalPieSlice(x0,y0,stangle,endangle,radx,rady:word);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    Sector(x0,y0,stangle,endangle,radx,rady);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rBezier(x0,y0,x1,y1,x2,y2,x3,y3,count:word);
type
  coord = record
    x,y : integer;
  end;

  CurveDataRec = array[0..65521 div sizeof(coord)] of coord;

var
  bezarray                  : array [0..3] of coord;

  procedure drawBezier(var d0:coord;nPoints,nSteps:word; colr : byte);
  {Formula:            3            2       2           3
         Q(t) = (1 - t) P1 + 3t(1-t) P2 + 3t (1-t)P3 + t P4
  }
  const
    nsa = 1/6;
    nsb = 2/3;
  var
    i,i2,i3,xx,yy                             : integer;
    {$IFDEF DOUBLENUM}
    t,tm3,t2,t2m3,t3,t3m3,nc1,nc2,nc3,nc4,step: double;
    {$ELSE}
    t,tm3,t2,t2m3,t3,t3m3,nc1,nc2,nc3,nc4,step: real;
    {$ENDIF}
    d                                         : curveDataRec absolute d0;
    oldx, oldy                                : integer;
  begin
    step := 1/nSteps;
    oldx := d[0].x;
    oldy := d[0].y;
    setcolor(colr);
    for i2 := 0 to pred(nPoints) div 4 do
    begin
      i := i2*4;
      t := 0.0;
      for i3 := pred(nSteps) downto 0 do
      begin
        t    := t+step;
{        t2   := (1-t);
        xx := round(t2*t2*t2*d[i].x + 3.0*t*t2*t2*d[i+1].x +
                    3.0*t*t*t2*d[i+2].x +   t*t*t*d[i+3].x);
        yy := round(t2*t2*(1-t)*d[i].y + 3.0*t*t2*t2*d[i+1].y +
                    3.0*t*t*t2*d[i+2].y +   t*t*t*d[i+3].y);
}
        tm3  := t*3.0;
        t2   := t*t;
        t2m3 := t2*3.0;
        t3   := t2*t;
        t3m3 := t3*3.0;
        nc1  := 1-tm3+t2m3-t3;
        nc2  := t3m3-2.0*t2m3+tm3;
        nc3  := t2m3-t3m3;
        nc4  := t3;
        xx := trunc(nc1*d[i].x+nc2*d[succ(i)].x+nc3*d[i+2].x+nc4*d[i+3].x);
        yy := trunc(nc1*d[i].y+nc2*d[succ(i)].y+nc3*d[i+2].y+nc4*d[i+3].y);
        if (oldx = 0) and (oldy = 0) then
        begin
          putpixel(xx,yy, colr);
          oldx := xx;
          oldy := yy;
        end
        else
        begin
          line(oldx, oldy, xx, yy);
          oldx := xx;
          oldy := yy;
        end;
      end;
    end;
  end;

begin
  if not LocalRip then
    exit;
  {$IFDEF MOUSE}
  MouseOff;
  {$ENDIF}
  bezarray[0].X := x0;
  bezarray[0].Y := y0;
  bezarray[1].X := x1;
  bezarray[1].Y := y1;
  bezarray[2].X := x2;
  bezarray[2].Y := y2;
  bezarray[3].X := x3;
  bezarray[3].Y := y3;
  drawBezier(bezarray[0],4,count,defcolor);
  {$IFDEF MOUSE}
  MouseOn;
  {$ENDIF}
end;

Procedure RipObj.rPolygon(numpoints:word; var PolyPoints; complete:boolean);
type
  PointRec = record
    X : word;
    Y : word;
  end;

  TempType = Array[1..512] of PointRec;
var
  polytemp : temptype;
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    polytemp := temptype(polypoints);
    if complete then
    begin
      polytemp[numpoints+1].X := polytemp[1].X;
      polytemp[numpoints+1].Y := polytemp[1].Y;
      drawpoly(numpoints+1,polytemp);
    end
    else
      drawpoly(numpoints,polytemp);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rFillPoly(numpoints:word; var polypoints);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    fillpoly(numpoints,polypoints);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rFill(x0,y0,border:word);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    FloodFill(x0,y0,border);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end
end;

Procedure RipObj.rLineStyle(style,pattern,thick:word);
begin
  if LocalRip then
    SetLineStyle(style,pattern,thick);
end;

Procedure RipObj.rFillStyle(style,color:word);
begin
  if LocalRip then
    SetFillStyle(style,color);
end;

Procedure RipObj.rFillPattern(pattern:fpt; color:word);
begin
  if LocalRip then
  begin
    SetFillStyle(UserFill,color);
    SetFillPattern(fillpatterntype(pattern),color);
  end;
end;

Procedure RipObj.rMouse(x0,y0,x1,y1:word; inv,reset:boolean; instr:string);
begin
  {$IFDEF MOUSE}
  AddRegion(x0,y0,x1,y1,inv,reset,instr);
  {$ENDIF}
end;

Procedure RipObj.rKillMouse;
begin
  {$IFDEF MOUSE}
  KillRegions;
  {$ENDIF}
end;

Procedure RipObj.rGetImage(x0,y0,x1,y1:word);
begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    if ClipB <> nil then
    begin
      FreeMem(ClipB,ClipSize);
      ClipSize := 0;
      ClipB := nil;
    end;
    ClipSize := ImageSize(x0,y0,x1,y1);
    GetMem(ClipB,ClipSize);
    GetImage(x0,y0,x1,y1,ClipB^);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rPutImage(x0,y0,mode:word);
begin
  if LocalRip then
  begin
    if ClipB = nil then
      Exit;
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    PutImage(x0,y0,ClipB^,mode);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rWriteIcon(fname:str12);
var
  IcnFile       : File;
  tname         : string;
begin
  if LocalRip then
  begin
    if ClipB = nil then
      Exit;
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    filemode := $02;
    tname := backslash(icondir)+fname;
    if pos('.',tname) = 0 then
      tname := tname + '.ICN';
    assign(IcnFile,tname);
    {$I-}
    rewrite(IcnFile,1);
    {$I+}
    if IOresult <> 0 then
    begin
      {$IFDEF MOUSE}
      MouseOn;
      {$ENDIF}
      exit;
    end;
    blockwrite(IcnFile,ClipB^,ClipSize);
    close(icnfile);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}

  end;
end;

Procedure RipObj.rLoadIcon(x0,y0,mode:word; clipbrd:boolean; fname:str12);
var
  cb            : pointer;
  cb2           : pointer;
  cbsize        : word;
  IcnFile       : file;
  thewid,thehgt : word;
begin
  if LocalRip then
  begin
    filemode := $20;
    assign(icnfile,backslash(IconDir)+fname);
    {$I-}
    reset(icnfile,1);
    if IOresult <> 0 then
      exit;
    {$I+}
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    seek(IcnFile,0);
    blockread(IcnFile,thewid,2);
    blockread(IcnFile,thehgt,2);
    cbsize := ImageSize(0,0,thewid,thehgt);
    getmem(cb,cbsize);
    seek(IcnFile,0);
    blockread(IcnFile,cb^,cbsize);
    close(icnfile);
    PutImage(x0,y0,cb^,mode);
    if clipbrd then
    begin
      if clipb <> nil then
      begin
        FreeMem(ClipB,ClipSize);
        ClipSize := 0;
        ClipB := nil;
      end;
      clipsize := cbsize;
      GetMem(ClipB,ClipSize);
      Move(cb^,clipb^,clipsize);
    end;
    freemem(cb,cbsize);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}
  end;
end;

Procedure RipObj.rButtonStyle(wid,hgt,orient,flags,bevsize,dfore,dback,bright,dark,
                              surface,grp_no,flags2,uline_col,corner_col:word);
begin
  ButPlainWidth       := wid;
  ButPlainHeight      := hgt;
  ButOrientation      := orient;
  ButFlags            := flags;
  ButBevelSize        := bevsize;
  ButLabelFore        := dfore;
  ButLabelDropShadow  := dback;
  ButPlainHilite      := bright;
  ButPlainShadow      := dark;
  ButPlainSurface     := surface;
  ButGroupNum         := grp_no;
  ButFlags2           := flags2;
  ButLabelUnderline   := uline_col;
  ButCorner           := corner_col;
end;

Procedure RipObj.rButton(tx0,ty0,tx1,ty1,hotkey:word; flags:byte; icon:str12; sLabel,Cmd:string);
type
  IconHdr = record
    tWid,
    tHgt : word;
  end;

var
  Trapezoid : array[1..4] of PointType;

  BClip, BInvertable, BReset, BChisel, BRecess, BDropShadow, BImage2Clip,
  BIconBut, BPlainBut, BBevel, BMouse, BUline, BHotIcons, BAdjustVert,
  BRadio, BSunken, BCheckbox, BHilite, BExplode, BLeftJust, BRightJust   : Boolean;

  X0,Y0,X1,Y1                   : integer;
  bWid,bHgt,tWid,tHgt,tX,tY     : integer;
  TempX0,TempY0,TempX1,TempY1   : integer;
  RecessTemp                    : Word;
  T2                            : Word;
  tst                           : TextSettingsType;
  lst                           : LineSettingsType;
  col                           : word; {color}
  DoneHilite                    : boolean;
  XChisel, YChisel              : Byte;

  cb            : pointer;
  cb2           : pointer;
  cbsize        : word;
  IcnFile       : file;
  thewid,thehgt : word;

  Function FlagOn(Flags : Word; FlagMask : Word) : Boolean;
  begin
    FlagOn := (Flags and FlagMask) <> 0;
  end;

  procedure SetFlagOn(var Flags : Word; FlagMask : Word);
  begin
    Flags := Flags or FlagMask;
  end;

  procedure SetFlagOff(var Flags : Word; FlagMask : Word);
  begin
    Flags := Flags and not FlagMask;
  end;

  Procedure PutItXY(x,y : word; thelabel : string);
  var
    thecounter : byte;
  begin
    MoveTo(x,y);
    for thecounter := 1 to length(thelabel) do
    begin
      if (not donehilite) and (upcase(thelabel[thecounter]) = char(hotkey)) then
      begin
        setcolor(ButLabelUnderline);
        OutText(thelabel[thecounter]);
        setcolor(ButLabelFore);
        donehilite := true;
      end
      else
        OutText(thelabel[thecounter]);
    end;
  end;

  Function Real_TextHeight: word;
  begin
    Real_TextHeight := Metric.Base - Metric.Top + 1;
  end;

  Function Contains_DropDown(st:string): boolean;
  var
    ct : byte;
  begin
    contains_dropdown := true;
    for ct := 1 to length(st) do
    begin
      if low_char[ord(st[ct])] = 1 then
        exit;
    end;
    contains_dropdown := false;
  end;

begin
  if LocalRip then
  begin
    {$IFDEF MOUSE}
    MouseOff;
    {$ENDIF}
    GetTextSettings(tst);
    GetLineSettings(lst);
    Col := GetColor;
    SetColor(0);
    {SetTextStyle(defaultfont,horizdir,1);}
    SetLineStyle(SolidLn,0,NormWidth);

{+} BClip := FlagOn(ButFlags,1);
{+} BInvertable := FlagOn(ButFlags,2);
{+} BReset := FlagOn(ButFlags,4);
{+} BChisel := FlagOn(ButFlags,8);
{+} BRecess := FlagOn(ButFlags,16);
{+} BDropShadow := FlagOn(ButFlags,32);
{+} BImage2Clip := FlagOn(ButFlags,64);
{+} BIconBut := FlagOn(ButFlags,128);
{+} BPlainBut := FlagOn(ButFlags,256);
{+} BBevel := FlagOn(ButFlags,512);
{+} BMouse := FlagOn(ButFlags,1024);
{-} BUline := FlagOn(ButFlags,2048);
{-} BHotIcons := FlagOn(ButFlags,4096);
{+} BAdjustVert := FlagOn(ButFlags,8192);
{-} BRadio := FlagOn(ButFlags,16384);
{+} BSunken := FlagOn(ButFlags,32768);
{-} BCheckbox := FlagOn(ButFlags2,1);
{+} BHilite := FlagOn(ButFlags2,2);
{-} BExplode := FlagOn(ButFlags2,4);
{+} BLeftJust := FlagOn(ButFlags2,8);
{+} BRightJust := FlagOn(ButFlags2,16);
    if not BMouse then
    begin
      BUline := false;
      BInvertable := false;
      BReset := false;
      BHotIcons := false;
      BRadio := false;
      BCheckbox := false;
      BHilite := false;
      BExplode := false;
    end;
    if not BIconBut then
    begin
      BHotIcons := false;
    end;
    if BHilite then
      DoneHilite := false
    else
      DoneHilite := true;

    {x/y adjustments based on button type go here}
    x0 := tx0;
    y0 := ty0;
    x1 := tx1;
    y1 := ty1;
    if BPlainBut and ((tx1 = 0) and (ty1 = 0)) then
    begin
      x1 := tx0+ButPlainWidth;
      y1 := ty0+ButPlainHeight;
    end;
    if BIconBut then
    begin
      filemode := $20;
      assign(icnfile,backslash(IconDir)+icon);
      {$I-}
      reset(icnfile,1);
      {$I+}
      if IOresult <> 0 then
      begin
        {$IFDEF MOUSE}
        MouseOn;
        {$ENDIF}
        exit;
      end;
      seek(IcnFile,0);
      blockread(IcnFile,thewid,2);
      blockread(IcnFile,thehgt,2);
      cbsize := ImageSize(0,0,thewid,thehgt);
      x1 := tx0+thewid;
      y1 := ty0+thehgt;
      getmem(cb,cbsize);
      seek(IcnFile,0);
      blockread(IcnFile,cb^,cbsize);
      close(icnfile);
    end;
    if BClip then
    begin
      if clipb <> nil then
      begin
        thewid := iconhdr(clipb^).tWid;
        thehgt := iconhdr(clipb^).tHgt;
        x1 := tx0+thewid;
        y1 := ty0+thehgt;
      end;
    end;

    SetColor(ButPlainSurface);
    SetFillStyle(SolidFill,ButPlainSurface);
    Bar(x0,y0,x1,y1);
    if BSunken then
    begin
      SetColor(ButPlainShadow);
      Line(x0,y0,x1,y0);
      Line(x0,y0,x0,y1);
      SetColor(ButPlainHiLite);
      Line(x0,y1,x1,y1);
      Line(x1,y0,x1,y1);
      SetColor(ButCorner);
      PutPixel(x0,y0,ButCorner);
      PutPixel(x1,y0,ButCorner);
      PutPixel(x0,y1,ButCorner);
      PutPixel(x1,y1,ButCorner);
    end;
    if BRecess then
    begin
      if BBevel then
        RecessTemp := ButBevelSize+2
      else
        RecessTemp := 2;
      SetColor(0);
      Rectangle(x0-recesstemp+1,y0-recesstemp+1,x1+recesstemp-1,y1+recesstemp-1);

      SetColor(ButPlainShadow);
      Line(x0-RecessTemp,y0-RecessTemp,x1+RecessTemp,y0-RecessTemp);
      Line(x0-RecessTemp,y0-RecessTemp,x0-RecessTemp,y1+RecessTemp);
      SetColor(ButPlainHiLite);
      Line(x1+RecessTemp,y0-RecessTemp,x1+RecessTemp,y1+RecessTemp);
      Line(x0-RecessTemp,y1+RecessTemp,x1+RecessTemp,y1+RecessTemp);
      SetColor(ButCorner);
      PutPixel(x0-RecessTemp,y0-RecessTemp,ButCorner);
      PutPixel(x1+RecessTemp,y0-RecessTemp,ButCorner);
      PutPixel(x0-RecessTemp,y1+RecessTemp,ButCorner);
      PutPixel(x1+RecessTemp,y1+RecessTemp,ButCorner);
    end;
    if BBevel then
    begin
      SetLineStyle(SolidLn,0,1);
      SetFillStyle(SolidFill,ButPlainHiLite);
      SetColor(ButPlainHiLite);
      Trapezoid[1].X := x0-ButBevelSize;  Trapezoid[1].Y := y0-ButBevelSize;
      Trapezoid[2].X := x0-1;             Trapezoid[2].Y := y0-1;
      Trapezoid[4].X := x1+ButBevelSize;  Trapezoid[4].Y := y0-ButBevelSize;
      Trapezoid[3].X := x1+1;             Trapezoid[3].Y := y0-1;
      FillPoly(4,Trapezoid);
      Trapezoid[4].X := x0-ButBevelSize;  Trapezoid[4].Y := y1+ButBevelSize;
      Trapezoid[3].X := x0-1;             Trapezoid[3].Y := y1+1;
      FillPoly(4,Trapezoid);
      SetFillStyle(SolidFill,ButPlainShadow);
      SetColor(ButPlainShadow);
      Trapezoid[1].X := x1+ButBevelSize;  Trapezoid[1].Y := y1+ButBevelSize;
      Trapezoid[2].X := x1+1;             Trapezoid[2].Y := y1+1;
      FillPoly(4,Trapezoid);
      Trapezoid[4].X := x1+ButBevelSize;  Trapezoid[4].Y := y0-ButBevelSize;
      Trapezoid[3].X := x1+1;             Trapezoid[3].Y := y0-1;
      FillPoly(4,Trapezoid);
      SetColor(ButCorner);
      Line(x0-ButBevelSize,y0-ButBevelSize,x0-1,y0-1);
      Line(x0-ButBevelSize,y1+ButBevelSize,x0-1,y1+1);
      Line(x1+1,y0-1,x1+ButBevelSize,y0-ButBevelSize);
      Line(x1+1,y1+1,x1+ButBevelSize,y1+ButBevelSize);
    end;
    if BChisel then
    begin
      case (y1-y0) of
        0..11    : begin  xchisel := 1;   ychisel := 1;  end;
        12..24   : begin  xchisel := 3;   ychisel := 2;  end;
        25..39   : begin  xchisel := 4;   ychisel := 3;  end;
        40..74   : begin  xchisel := 6;   ychisel := 5;  end;
        75..149  : begin  xchisel := 7;   ychisel := 5;  end;
        150..199 : begin  xchisel := 8;   ychisel := 6;  end;
        200..249 : begin  xchisel := 10;  ychisel := 7;  end;
        250..299 : begin  xchisel := 11;  ychisel := 8;  end;
        300..999 : begin  xchisel := 13;  ychisel := 9;  end;
      end;
      setcolor(ButPlainHiLite);
      rectangle(x0+xchisel+1,y0+ychisel+1,x1-xchisel,y1-ychisel);
      setcolor(ButPlainShadow);
      rectangle(x0+xchisel,y0+ychisel,x1-(xchisel+1),y1-(ychisel+1));
      putpixel(x0+xchisel,y1-ychisel,ButPlainShadow);
      putpixel(x1-xchisel,y0+ychisel,ButPlainShadow);
    end;

    if BIconBut then
    begin
      PutImage(tx0,ty0,cb^,0);
      freemem(cb,cbsize);
    end;
    if BClip then
    begin
      if clipb <> nil then
        PutImage(tx0,ty0,clipb^,0);
    end;
    if BImage2Clip or BMouse then
    begin
      tempx0 := x0;  tempx1 := x1;
      tempy0 := y0;  tempy1 := y1;
      if BBevel then
      begin
        dec(tempx0,butbevelsize);
        dec(tempy0,butbevelsize);
        inc(tempx1,butbevelsize);
        inc(tempy1,butbevelsize);
      end;
    end;
    if BImage2Clip then
    begin
      if clipb <> nil then
      begin
        FreeMem(ClipB,ClipSize);
        ClipSize := 0;
        ClipB := nil;
      end;
      clipsize := ImageSize(tempx0,tempy0,tempx1,tempy1);
      GetMem(ClipB,ClipSize);
      GetImage(tempx0,tempy0,tempx1,tempy1,clipb^);
    end;
    if BMouse then
    begin
      {$IFDEF MOUSE}
      AddRegion(tempx0,tempy0,tempx1,tempy1,BInvertable,BReset,cmd);
      {$ENDIF}
    end;

    if sLabel <> '' then
    begin
      bwid := x1-x0;
      bhgt := y1-y0;
      if BBevel then
      begin
        inc(bwid,2*butbevelsize);
        inc(bhgt,2*butbevelsize);
        dec(x0,butbevelsize);
        dec(y0,butbevelsize);
        inc(x1,butbevelsize);
        inc(y1,butbevelsize);
      end;
      twid := textwidth(slabel);
      thgt := real_textheight;
      if brecess then
      begin
        dec(x0,2);
        dec(y0,2);
        inc(x1,2);
        inc(y1,2);
      end;

      case ButOrientation of
  {top} 0 : begin
              if bleftjust then
              begin
                if bchisel then
                  tx := x0+20
                else
                  tx := x0+10;
              end
              else
                if brightjust then
                begin
                  if bchisel then
                    tx := x0+bwid-twid-20
                  else
                    tx := x0+bwid-twid-10;
                end
                else
                  tx := x0+((bwid-twid) div 2);
              ty := y0-5-thgt;
              if contains_dropdown(slabel) and badjustvert then
                dec(ty,(metric.drop-metric.base));
            end;
 {left} 1 : begin
              if contains_dropdown(slabel) and badjustvert then
                inc(thgt,(metric.drop-metric.base));
              tx := x0-twid-8;
              ty := y0+((bhgt-thgt) div 2)+2;
              if buline then
                dec(ty,1);
              if contains_dropdown(slabel) then
                inc(ty,(metric.drop-metric.base) div 2);
            end;
{center}2 : begin
              if contains_dropdown(slabel) and badjustvert then
                inc(thgt,(metric.drop-metric.base));
              if bleftjust then
              begin
                if bchisel then
                  tx := x0+20
                else
                  tx := x0+10;
              end
              else
                if brightjust then
                begin
                  if bchisel then
                    tx := x0+bwid-twid-20
                  else
                    tx := x0+bwid-twid-10;
                end
                else
                  tx := x0+((bwid-twid) div 2);
              ty := y0 + ((bhgt-thgt) div 2)+1;
            end;
{right} 3 : begin
              if contains_dropdown(slabel) and badjustvert then
                inc(thgt,(metric.drop-metric.base));
              tx := x1+8;
              ty := y0+((bhgt-thgt) div 2)+2;
              if buline then
                dec(ty,1);
              if contains_dropdown(slabel) then
                inc(ty,(metric.drop-metric.base) div 2);
            end;
{bottom}4 : begin
              if bleftjust then
              begin
                if bchisel then
                  tx := x0+20
                else
                  tx := x0+10;
              end
              else
                if brightjust then
                begin
                  if bchisel then
                    tx := x0+bwid-twid-20
                  else
                    tx := x0+bwid-twid-10;
                end
                else
                  tx := x0+((bwid-twid) div 2);
              ty := y1+3;
            end;
      end; {case}
      if brecess then
      begin
        inc(ty,2);
        inc(tx,2);
      end;
      if bclip then
      begin
        if not contains_dropdown(slabel) then
          dec(ty,1);
      end
      else
        if (biconbut or bplainbut) then
          dec(ty,1);

      {display label finally}
      if bdropshadow then
      begin
        setcolor(butlabeldropshadow);
        outtextxy(tx+1,ty+1-metric.top,slabel);
      end;
      setcolor(butlabelfore);
      putitxy(tx,ty-metric.top,slabel);
    end; {if slabel...}
    if BImage2Clip then
    begin
      SetFlagOn(ButFlags,1);
      SetFlagOff(ButFlags,128);
      SetFlagOff(ButFlags,256);
      SetFlagOff(ButFlags,8);
      SetFlagOff(ButFlags,512);
      SetFlagOff(ButFlags,64);
      SetFlagOff(ButFlags,32768);
    end;

    SetColor(col);
    with tst do
      SetTextStyle(font,direction,charsize);
    with lst do
      SetLineStyle(LineStyle,Pattern,Thickness);
    {$IFDEF MOUSE}
    MouseOn;
    {$ENDIF}

  end;
end;